Trabajaremos en base a un ciclo productivo Salmo salar de 54 semanas, con iguales condiciones para las 10 jaulas. Tomaremos datos de peso promedio final, conversión, mortalidad y velocidad de crecimiento en gramos por semana.
datos <- read_excel("/cloud/project/jaula.xlsx")
head(datos)
## # A tibble: 6 × 6
## sem jaula grupo pprom znum fcr
## <dbl> <chr> <chr> <dbl> <dbl> <dbl>
## 1 1 J101 SISA 124. 515 0.863
## 2 2 J101 SISA 132. 686 0.863
## 3 3 J101 SISA 146. 167 0.865
## 4 4 J101 SISA 161. 45 0.867
## 5 5 J101 SISA 182. 27 0.869
## 6 6 J101 SISA 209. 26 0.873
#histograma con mas datos de ejes y mas cadenas de comandos#
#histograma para pprom#
hist(x = datos$pprom, main = "Histograma de Pesos promedio",
xlab = "Gramos", ylab = "Frecuencia",
col = "brown")
La distribución de pesos promedios tiene una alta aglomeración en el rango < a 200 [gr], lo cual nos da un indicio de que el grupo conformado por peces provenientes de piscicultura RAS SEALAND, posee un peso menor al de los peces FA SISA.
#histograma para znum#
hist(x = datos$znum, main = "Histograma de numero de mortalidad",
xlab = "N mortalidad", ylab = "Frecuencia",
col = "grey")
La distribucion de frecuencias de mortalidad, tambien nos indica que los peces muertos con mayor frecuencia, pertenecen al grupo < a 2000 [gr]
Realizaremos pruebas de homocedasticidad e independencia de los datos a trabajar.
par(mfrow=c(2, 3))
plot(density(datos$pprom))
plot(density(datos$znum))
plot(density(datos$fcr))
plot(ecdf(datos$pprom))
plot(ecdf(datos$znum))
plot(ecdf(datos$fcr))
##inndependencia y variacion entre los datos
ggplot(datos, aes(x=grupo, y=pprom, fill = grupo)) +
geom_boxplot()
ggplot(datos, aes(x=grupo, y=pprom, fill = grupo)) +
labs(y = "Peso promedio (g")+
geom_boxplot() +
geom_jitter()
#interaccion entre los datos##
interaction.plot(datos$grupo, datos$pprom, datos$fcr)
corPlot(datos[,4:6], cex = 1.9, main = "Matriz de correlación")
Las pruebas de interacción y correlación, no son determinantes como para decidir la diferencia entre los grupos de peces de pisciculturas de recirculación (RAS) y flujo abierto (FA). Por lo tanto, previo a un análisis de hipótesis, realizaremos una exploración visual del comportamiento del centro en cuestión.
grafico <- datos %>%
ggplot() +
geom_point(aes(x = pprom, y = fcr, col = grupo, size = znum), alpha = 0.8) + theme_classic() +
theme(legend.position = "bottom") + guides(size = "none") +
labs(x = "Peso Promedio [gr]" ,y = "FCR", col = "")
grafico +
transition_time(sem)
##
Otra visión, nos la puede entregar la velocidad de crecimiento por
semana, es decir, expresar una tasa de cambio para cada grupo en
[gr/sem]. Ésto queda evidenciado al observar ambos grupos durante las 54
semanas de cultivo.
velocidades <- read_excel("/cloud/project/velocidades.xlsx")
head(velocidades)
## # A tibble: 6 × 5
## sem grupo grporsem znum fcr
## <dbl> <chr> <dbl> <dbl> <dbl>
## 1 1 SISA 6 746 0.468
## 2 2 SISA 6.02 2166 0.865
## 3 3 SISA 12.4 351 0.867
## 4 4 SISA 11.3 86 0.868
## 5 5 SISA 17.5 85 0.870
## 6 6 SISA 24.5 78 0.873
#velocidad crecimiento SISA
velocidades %>%
filter(grupo == "SISA") %>%
ggplot(aes(sem, grporsem)) + geom_point() + geom_line() +
geom_text(aes(x = min(sem), y = min(grporsem), label = as.factor(sem)) , hjust=-2, vjust = -0.2, alpha = 0.5, col = "gray", size = 20) +
theme_minimal() +
transition_reveal(sem) +
ggtitle("Velocidad crecimiento",
subtitle = "SISA")+
view_follow()
#Velocidad crecimiento SEALAND
velocidades %>%
filter(grupo == "SEALAND") %>%
ggplot(aes(sem, grporsem)) + geom_point() + geom_line() +
geom_text(aes(x = min(sem), y = min(grporsem), label = as.factor(sem)) , hjust=-2, vjust = -0.2, alpha = 0.5, col = "gray", size = 20) +
theme_minimal() +
transition_reveal(sem) +
ggtitle("Velocidad crecimiento",
subtitle = "SEALAND")+
view_follow()
all <- read_excel("/cloud/project/jaulas.xlsx")
all%>%
ggplot(aes(x = semana, y = pprom, color = jaula))+
geom_line( )+
geom_point()+
xlab("Semana")+
ylab("Peso [gr]")+
labs(color = "Jaula")+
ggtitle("Evoluci?n peso por jaula")+
theme_minimal()
#creamos el objeto de ggplot
g1 = all%>%
ggplot(aes(x = semana, y = pprom, color = jaula))+
geom_line(size = 1)+
geom_point(aes(group = seq_along(semana)), size = 2)+
#estos son los segmentos que unirás las lineas con los datos
geom_segment(aes(xend = 54, yend = pprom, group = jaula),
linetype = 2, colour = 'grey') +
#Los datos:
geom_text(aes(x = 54, label = jaula), hjust = 0)+
guides(color = FALSE)+
scale_color_got_d(option = "Daenerys")+
scale_x_continuous(breaks = seq(1, 54, by = 2),
limits = c(1, 54))+
xlab("")+
ylab("")+
ggtitle("Crecimiento Forsyth 2021",
subtitle = "Crecimiento semanal por jaula, 1 - 54")+
labs(caption="Alain Munoz ")+
theme_minimal()+
#aumentando la fuentte para que sea mas amigable en el gif:
theme(plot.title = element_text(size = 15),
plot.subtitle = element_text(size = 12),
axis.text.x = element_text(size = 10),
plot.caption = element_text(size = 10, color = "grey40"))+
#animacion
transition_reveal(semana)+
coord_cartesian(clip = 'off') +
enter_fade() +
exit_shrink()
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
#moviendo el objeto:
animate(g1)
knitr::opts_chunk$set(warning = FALSE, message = FALSE)
en una primera parte, la gráfica de cajas nos indica que las medias poblacionales μ1 y μ2 de ambos grupos no son iguales ya que no se tralapan. En este problema interesa estudiar el siguiente conjunto de hipótesis.
H0:μ1−μ2=0 H1:μ1−μ2≠0
ggplot(datos, aes(x=grupo, y=pprom, fill = grupo)) +
labs(y = "Peso promedio (g")+
geom_boxplot() +
geom_jitter()
#los boxplot no se traslapan, nos da un indicio de que las medias poblacionales son distintas
grupos <- read_excel("/cloud/project/grupos.xlsx")
as.data.frame(grupos)
## sem ppromss ppromsl
## 1 1 139.1794 184.3427
## 2 2 145.2035 200.3450
## 3 3 157.6431 215.9936
## 4 4 168.9425 230.8673
## 5 5 186.4506 251.2206
## 6 6 210.9870 276.7803
## 7 7 249.7332 298.9653
## 8 8 280.4183 316.1029
## 9 9 305.0483 335.9932
## 10 10 338.1619 359.3034
## 11 11 375.8539 379.3447
## 12 12 415.3038 392.6052
## 13 13 462.3560 413.6299
## 14 14 500.3339 449.0531
## 15 15 558.3747 489.5114
## 16 16 620.3998 531.5125
## 17 17 690.3836 575.8992
## 18 18 773.7972 622.7047
## 19 19 856.9679 666.1560
## 20 20 904.9500 709.1087
## 21 21 1043.6810 730.2162
## 22 22 1143.1602 760.1709
## 23 23 1224.3871 811.2488
## 24 24 1344.2871 863.5821
## 25 25 1477.7106 918.8313
## 26 26 1614.9854 972.8082
## 27 27 1748.9884 1014.1012
## 28 28 1893.7601 1055.5458
## 29 29 2020.9200 1071.9827
## 30 30 2159.6260 1117.4539
## 31 31 2361.8425 1171.9180
## 32 32 2496.0983 1226.1402
## 33 33 2641.3637 1275.9113
## 34 34 2785.4437 1321.8174
## 35 35 2926.6051 1371.0121
## 36 36 3069.5211 1415.1085
## 37 37 3176.9594 1459.5191
## 38 38 3330.2041 1510.1223
## 39 39 3456.3561 1561.1048
## 40 40 3603.2229 1595.7278
## 41 41 3723.7186 1646.9338
## 42 42 3846.4290 1684.3866
## 43 43 3929.7629 1711.6949
## 44 44 4038.0023 1796.9829
## 45 45 4143.9461 1829.1533
## 46 46 4266.5136 1861.9857
## 47 47 4425.9471 1864.7376
## 48 48 4544.8336 1869.2107
## 49 49 4642.2031 1888.0794
## 50 50 4635.4414 1930.3721
## 51 51 4661.5928 2016.3848
## 52 52 4694.7869 1985.1222
## 53 53 4826.5577 1851.6610
## 54 54 4830.0000 1920.0000
t.test(x=grupos$ppromss, y=grupos$ppromsl, alternative="two.sided", mu=0,
paired=FALSE, var.equal=FALSE, conf.level=0.95)
##
## Welch Two Sample t-test
##
## data: grupos$ppromss and grupos$ppromsl
## t = 4.4778, df = 67.141, p-value = 3.001e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 596.2267 1555.2133
## sample estimates:
## mean of x mean of y
## 2130.914 1055.194